Content-based Recommender

R-Version: [Default] [32-bit] C:\Program Files\R\R-4.1.0

In folgendem Notebook werden anhand des MovieLense Datensatzes aus dem Paket RecommenderLab verschiedene Recommender erstellt. Es werden verschiedene Recommender und verschiedene Ähnlichkeiten verwendet, um diese zu vergleichen und auszuwerten. Ziel ist es, ein möglichst guter Recommender zu erstellen und zu verstehen wie dieser funktioniert. Zudem soll verstanden werden wie dieser bewertet wird und was in diesem Falle ein ‘guter’ Recommender bedeutet.

Dieses Notebook konzentriert sich auf Erkenntnisse von Auswertungen und Vergleichen. Um eine bessere Übersicht zu erhalten wurden grosse, sich widerholende Codes im Helperfile helper.R ausgelagert.

2.Binäre User-Liked-Items Matrix für alle Nutzer erzeugen.

movies_binary <- movies %>% mutate(rating = ifelse(rating > 3, 1, 0))
movies_wider <- pivot_wider(movies_binary, id_cols = user, names_from = item, values_from = rating)
rownames(movies_wider) <- movies_wider$user

Warning: Setting row names on a tibble is deprecated.

movies_wider['user'] <- NULL
user_movie_matrix <- as.matrix(movies_wider)
movies_wider

Für die Binäre User-Liked Matrix setzten wir die Grenze für ein gutes Rating bei >4. Also alle Filme, welche mit einem Rating von 3 oder weniger bewertet wurden, werden als schlecht bewertet definiert (also 0), wobei Filme mit Bewertungen von 4 oder 5 als gut bewertet definiert sind (1).

binary_non_na <- as(binarize(MovieLense, minRating = 4), 'matrix') * 1
binary_non_na[1:3, 1:3]

  Toy Story (1995) GoldenEye (1995) Four Rooms (1995)
1                1                0                 1
2                1                0                 0
3                0                0                 0

3.Dimension der User-Liked-Items Matrix prüfen und ausgeben.

dim(user_movie_matrix)

[1]  943 1664

Es sind 943 Users und 1664 bewertete Filme vorhanden. Dies entspricht der Dimension der Ursprungsdaten.

4.Movie-Genre Matrix für alle Filme erzeugen.

genres <- MovieLenseMeta
genres <- genres %>% select("title",'unknown':'Western')
rownames(genres) <- genres$title
genres['title'] <- NULL
movie_genre_matrix <- as.matrix(genres)
genres

5.Dimension der Movie-Genre Matrix prüfen und ausgeben.

dim(movie_genre_matrix)

[1] 1664   19

In dieser Matrix sind die 1664 Filme einem oder mehreren von 19 genres zugeordnet.

6.Anzahl unterschiedlicher Filmprofile bestimmen und visualisieren.

movie_genre_profile_matrix <- as.matrix(apply(movie_genre_matrix == 1, 1, 
                                       function(a) paste0(colnames(movie_genre_matrix)[a], collapse = "")))
movie_genre_profile_df <- as.data.frame(movie_genre_profile_matrix)
movie_genre_profile_df$items <- rownames(movie_genre_profile_df)

#movie_genre_profile_list <- c(unique(movie_genre_profile_df$V1))
#movie_genre_profile_list <- strsplit(movie_genre_profile_list, "\n")
#length(movie_genre_profile_list)

movie_genre_profile_df

TODO: igewie die einzelne genreprofil zelle, inen df speichere und plotte(grafik vode slides vom dani, glaub folie 13) TODO: Tipp (bitte wieder löschen): movieLenseGenres <- mutate(movieLenseMetaReduced, unknown=ifelse(unknown==1, “Unknown”, NA), Action=ifelse(Action==1, “Action”, NA), Adventure=ifelse(Adventure==1, “Adventure”, NA), Animation=ifelse(Animation==1, “Animation”, NA), Children's=ifelse(Children's==1, “Childrens”, NA), Comedy=ifelse(Comedy==1, “Comedy”, NA), Crime=ifelse(Crime==1, “Crime”, NA), Documentary=ifelse(Documentary==1, “Documentary”, NA), Drama=ifelse(Drama==1, “Drama”, NA), Fantasy=ifelse(Fantasy==1, “Fantasy”, NA), Film-Noir=ifelse(Film-Noir==1, “Film.Noir”, NA), Horror=ifelse(Horror==1, “Horror”, NA), Musical=ifelse(Musical==1, “Musical”, NA), Mystery=ifelse(Mystery==1, “Mystery”, NA), Romance=ifelse(Romance==1, “Romance”, NA), Sci-Fi=ifelse(Sci-Fi==1, “Sci.Fi”, NA), Thriller=ifelse(Thriller==1, “Thriller”, NA), War=ifelse(War==1, “War”, NA), Western=ifelse(Western==1, “Western”, NA), ) movieLenseGenres <- movieLenseGenres %>% unite(‘Combination’, unknown:Western, sep = “-”, na.rm = TRUE) movieLenseCombinations <- movieLenseGenres %>% count(Combination, sort = TRUE)

topCombinations <- head(movieLenseCombinations, 30) notTopCombimations <- tail(movieLenseCombinations, -30) topCombinations <- rbind(topCombinations, c(“Andere Kombinationen”, sum(notTopCombimations$n))) topCombinations <- mutate(topCombinations, n = as.integer(n))

ggplot(topCombinations) + geom_col(aes(x = reorder(Combination, n), y = n)) + coord_flip() + labs(title = “Verteilung der Filme nach Genre-Kombination”, subtitle = paste(“Top-30 Kombinationen von insgesamt”, nrow(movieLenseCombinations)))+ xlab(“Genre”) + ylab(“Anzahl Views”)

In dem MovieLense Datenset sind insgesamt 216 verschiedene Genreprofile von den Filmen vertreten. Das bedeitet, es sind 216 verschiedene Genrekombinationen aus den 16 gegebenen Genres entstanden. (r isch so en seich plötzlich bruuchsch nömm ‘as(data, ’data.frame)’ sondern ‘as.data.frame(data)’ WIESO????) - will as(x, ‘data.frame’) vo recommenderlab isch (nur ide vo recommenderlab gwollte Struktur funktioniert) und as.data.frame(x) vo r isch und nur for matrix-df lauft defür allgemeiner ihsetzbar isch.

movie_genre_profile_df <- movie_genre_profile_df %>%
  group_by(V1)
movie_genre_profile_df

nr_diff_movies <- binary_non_na %*% movie_genre_matrix
nr_diff_movies <- as.data.frame(nr_diff_movies)

nr_diff_movies_mean <- rownames_to_column(nr_diff_movies)

nr_diff_movies_mean <- pivot_longer(nr_diff_movies_mean, cols = !rowname, names_to = 'genre', values_to = 'count')
nr_diff_movies_mean <- nr_diff_movies_mean %>% group_by(genre) %>% summarize(count = mean(count))

nr_diff_movies

TODO: Visualisierung der verschiedener Nutzerprofile ( siehe slide 13 Daniel) In dieser Matrix ist zu sehen wie viele Filme pro genre mit mehr als 3 bewertet wurden, jeweils pro User.

nr_diff_movies_mean

nr_diff_movies_mean %>% mutate(genre = fct_reorder(genre, count)) %>% 
  ggplot(aes(x = genre, y = count)) + 
  geom_col(fill = 'steelblue') +
  coord_flip() +
  scale_y_continuous(expand = c(0,0), limits = c(0, 30)) +
  geom_text(aes(label = round(count, 2)), hjust=-0.2, color = 'black') +
  labs(
    title = "Duchschnittliche Anzahl positiv bewerteter Filme pro Genre",
    x = element_blank(), 
    y = "Anzahl",
    fill = element_blank()
  ) +
  theme_classic() + 
  theme(
    text = element_text(size = 12),
    legend.position = 'bottom'
  )

7.User-Genre-Profil Matrix mit Nutzerprofilen im Genre-Vektorraum erzeugen.

bin_user_items <- as.matrix(movies_wider)
bin_user_items[is.na(bin_user_items)] <- 0

user_genre_matrix <- bin_user_items %*% movie_genre_matrix

bin_user_items[1:5,1:5]

     Toy Story (1995) GoldenEye (1995) Four Rooms (1995) Get Shorty (1995) Copycat (1995)
[1,]                1                0                 1                 0              0
[2,]                1                0                 0                 0              0
[3,]                0                0                 0                 0              0
[4,]                0                0                 0                 0              0
[5,]                1                0                 0                 0              0

##8.Dimension der User-Genre-Profil Matrix prüfen und ausgeben.

user_genre_matrix[1:5,1:5]

     unknown Action Adventure Animation Children's
[1,]       1     39        17         5          5
[2,]       0      7         3         1          2
[3,]       0      3         2         0          0
[4,]       0      5         2         0          0
[5,]       1     23        14         8          5

dim(user_genre_matrix)

[1] 943  19

In dieser Matrix sind die Anzahl positiv bewerteter Filme pro genre für jeden User dargestellt.

9.Anzahl unterschiedlicher Nutzerprofile bestimmen, wenn Stärke der GenreKombination (a) vollständig bzw. (b) nur binär berücksichtigt wird.

user_genre_df <- as.data.frame(user_genre_matrix)
user_genre_diff <- user_genre_df %>% mutate(across(.cols = everything(), .fns = ~ifelse(.x > 0, 1, 0)))

paste("Users: ", as.character(dim(user_genre_df)[1]))

[1] "Users:  943"

paste("vollständig identisch:", as.character(dim(user_genre_df)[1] - count(distinct(user_genre_df))))

[1] "vollständig identisch: 0"

paste("binär identisch: ", as.character(dim(user_genre_df)[1] - count(distinct(user_genre_diff))))

[1] "binär identisch:  562"

Es gibt bei Betrachtung vollständiger Nutzerprofilen keine identischen Nutzerprofile. Bei binärer Betrachtung sind jedoch fast 2/3 der Nutzerprofile identisch.

Ähnlichkeit von Nutzern und Filmen

1.Cosinus-Ähnlichkeit zwischen User-Genre- und Movie-Genre-Matrix berechnen.

Test

A_test.data <- c(1.5,2.5, 1.,0.5)
A_test <- matrix(A_test.data, nrow=2)
A_test

     [,1] [,2]
[1,]  1.5  1.0
[2,]  2.5  0.5

B_test.data <- c(0.5,1., 1.5,2.)
B_test <- matrix(B_test.data, nrow=2)
B_test

     [,1] [,2]
[1,]  0.5  1.5
[2,]  1.0  2.0

result <- calc_cos_similarity_twomtrx(A_test, B_test)

if((dim(result) == dim(B_test)) && (dim(result) == dim(A_test))) {
  print("dimensions match")
} else {
  print("dimensions do not match")
}

[1] "dimensions match"

check.data <- c(0.79, 0.50, 0.87, 0.61)
check <- matrix(check.data, nrow=2)

if(max(abs(check - result)) < 1e-2){
  print("check match")
} else{
  print("check differs from result")
}

[1] "check match"

In diesem Beispiel wurde für zwei 2x2 Matrizen mit zufällig gewählten Werten die cosine similarity berechnet. Diese Berechnung wurde ebenfalls von Hand gemacht und mit der Implementierung abgegelichen. Zusätzlich wurden die Dimensionen der Inputmatrizen mit der resultierenden Matrix abgeglichen. Die Berechnung der Cosine Similarity ist somit korrekt.

Anschliessend wird die Cosine Similarity der user-genre und movie-genre Matrixberechnet. Für die Berechnung muss die zweite Matrix transponiert werden, damit für die Matrix Multiplikation die Anzahl Spalten der ersten Matrix der Anzahl Zeilen der zweiten übereinstimmt.

dim(user_genre_matrix)

[1] 943  19

dim(movie_genre_matrix)

[1] 1664   19

similarity <- calc_cos_similarity_twomtrx(user_genre_matrix, t(movie_genre_matrix))

2. Dimension der Matrix der Cosinus Ähnlichkeiten von Nutzern und Filmen prüfen uns ausgeben.

dim(similarity)

[1]  943 1664

Wie die Dimension schon erahnen lässt ist in dieser Matrix die Similarity zwischen Usern und Filmen abgebildet.

3. 5 Zahlen Statistik für Matrix der Cosinus Ähnlichkeiten prüfen uns ausgeben.

summary(c(similarity))

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
 0.0000  0.2300  0.4070  0.4098  0.5919  0.9768    1664 

Die similarities liegen zwischen 0 und 1, was bei Betrachtung der ausschliesslich positiven Bewertung Sinn ergibt. Da das Minimum bei 0 liegt, gibt es user-item Kombinationen welche keine Ähnlichkeiten aufweisen. Das Maximum von 0.9768 bedeutet, dass es sehr hohe Ähnlichkeiten zwischen user- und movie Kombinationen gibt. Interessant ist, dass 1664 NA Werte bestehen. Dies hat zu bedeuten, dass es einen User gibt, welche alle movies negativ bewertet hat.

which(is.na(similarity), arr.ind = T)[1]

[1] 685

Wie hier gezeigt, ist dies der Nutzer 685.

4. Cosinus Ähnlichkeiten von Nutzern und Filmen mit Dichteplot visualisieren.

similarity_df <- as.data.frame(similarity)
similarity_df <- pivot_longer(similarity_df, cols=colnames(similarity_df))
similarity_df

ggplot(similarity_df) +
      geom_density(aes(x = value)) +
      ggtitle("Dichteplot Cosinus Similarity zwischen user-genre und movies-genre") +
      xlab("similarity")

Warning: Removed 1664 rows containing non-finite values (stat_density).

plot_sim(similarity, "Cosinus similarity zwischen user-genre und movie-genre")

Bei der Visualisierung aller similarities wird sichtbar, dass sich die Farbunterschiede eher hoizontal ausprägen. Dies bedeutet, dass der Einfluss von Nutzern, die generell besser oder generell schlechter bewerten höher ist als die similarities zwischen den Filmen.

5. Cosinus Ähnlichkeiten von Nutzern und Filmen mit Dichteplot für Nutzer “241”, “414”, “477”, “526”, “640” und “710”

selection <- as.data.frame(similarity)[c(241, 414, 477, 526, 640, 710), ]
genres <- colnames(selection)
selection$users <- rownames(selection)
selection_long <- selection %>% pivot_longer(cols = genres)

ggplot(selection_long, aes(x=value, fill=users)) + geom_density(alpha=0.3) + 
    labs(title="Density plot Cosinus-Ähnlichkeiten ausgewählte users", subtitle="", x="similarity")

    
#plot_sim(selection, "cosine similarity user-genre and movie-genre selection")

Hier wird nochmals sichtbar, dass das die similarities pro user sehr unterschiedlich sein können. Nummer 640 hat beispielsweise eine grössere similarity Ausprägung bei etwa 0.4. Häufig sind Buckel zu erkennen, was bedeutet dass Nutzer gewisse genres besser oder schlechter bewerten.

Empfehlbare Filme

1. Bewertete Filme maskieren, d.h. “Negativabzug” der User-Items Matrix erzeugen, um anschliessend Empfehlungen herzuleiten.

movies_masked <- movies_wider
movies_masked[-1][movies_masked[-1] == 1] <- 0
movies_masked[is.na(movies_masked)] <- 1
movies_masked

2. Zeilensumme des “Negativabzuges” der User-Items Matrix für die User “5”, “25”, “50” und “150” ausgeben.

defined_user <- c(5, 25, 50, 150)
defined_user
rowSums(movies_masked[defined_user, -1])

Hier zu sehen sind die anzahl nicht bewerteter filme pro user

3. 5-Zahlen Statistik der Zeilensumme des “Negativabzuges” der User-Items Matrix bestimmen.

rowsums_masked <- rowSums(movies_masked[, -1])
summary(rowsums_masked)

Top-N Empfehlungen

1.Matrix für Bewertung aller Filme durch element-weise Multiplikation der Matrix der Cosinus-Ähnlichkeiten von Nutzern und Filmen und “Negativabzug” der User-Items Matrix erzeugen.

rating_matrix <- user_movie_matrix * movies_masked

2.Dimension der Matrix für die Bewertung aller Filme prüfen.

dim(rating_matrix)

rating_matrix

3.Top-20 Listen pro Nutzer extrahieren.

get_topn_recos <- function(rating_matrix, n){
  herdöpfel <- as(rating_matrix, 'realRatingMatrix')
  herdöpfel <- as(herdöpfel, 'data.frame')
  herdöpfel <- arrange(desc(herdöpfel$ratings)) %>%
    group_by(user) %>%
    slice(head(n)) %>%
    ungroup()
  return(herdöpfel)
}

recommendation <- get_topn_recos(rating_matrix, 20)
recommendation

4.Länge der Top-20 Listen pro Nutzer prüfen.

summary(recommendation)

##5.Verteilung der minimalen Ähnlichkeit für Top-N Listen für N = 10, 20, 50 und 100 für alle Nutzer visuell vergleichen.

analyze_topn_recos <- function(rating_matrix, list){
  recoms <- c()
  for (n in list) {
    recoms <- append(recoms, get_topn_recos(rating_matrix, n))
  }
  return(recoms)
}

analyze_topn_recos(rating_matrix, c(10, 20, 50, 100))

TODO: igewie visualisiere

##6.Top-20 Empfehlungen für Nutzer “5”, “25”, “50” und “150” visuell evaluieren.

defined_user_lists <- get_topn_recos(ratingmatrix, 20) %>%
  filter(user == c(5, 25, 50, 50, 150)) %>%
  ungroup()

defined_user_lists

TODO: clevelandplot

##7.Für Nutzer “133” und “555” Profil mit Top-N Empfehlungen für N = 20, 30, 40, 50 analysieren, visualisieren und diskutieren.

analyze_topn_recos(rating_matrix[c(133, 555),], c(20, 30, 40, 50))

TODO: Clevelandplot + diskussion